perm filename PREDIC.LSP[BNF,JRA]2 blob sn#024550 filedate 1973-02-14 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP <PREDIC> 
00400	 (LAMBDA NIL
00500	  (NLRR (QUOTE PREDIC)
00600		(FUNCTION
00700		 (LAMBDA NIL
00800		  (COND ((AND (SPWD ANCESTRY)) (QUOTE ANCESTRY))
00900			((AND (SPWD NONE)) (QUOTE NONE))
01000			((AND (SPWD VINE)) (QUOTE VINE))
01100			((AND (SPWD UNIT)) (QUOTE UNIT))
01200			((AND (SPWD P1)) (QUOTE ALLPOS))
01300			((AND (SPWD P2)) (QUOTE ALLNEG))
01400			((AND (SPWD SUPPORT) (CH /[) (<C>) (CH /])) (CONS (QUOTE SUPPORT) (STK 1)))
01500			((AND (SPWD DEPTH) (CH /[) (<NUMBER>) (CH /]))
01600			 (CONS (QUOTE GREATERP)
01700			       (CONS (CONS (QUOTE DEPTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
01800				     (CONS (STK 1) NIL))))
01900			((AND (SPWD LENGTH) (CH /[) (<NUMBER>) (CH /]))
02000			 (CONS (QUOTE GREATERP)
02100			       (CONS (CONS (QUOTE LENGTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL))
02200				     (CONS (STK 1) NIL))))
02300			((AND (SPWD MODEL) (CH /[) (<PREDLST>) (CH ;) (<PREDLST1>) (CH /]))
02400			 (CONS (QUOTE MODEL) (CONS (STK 3) (CONS (STK 1) NIL))))
02500			((AND (SPWD EQUALITY) (CH /[) (<OP>) (CH /,) (<NUMBER>) (CH /]))
02600			 (CONS (QUOTE EQUALITY) (CONS (STK 3) (CONS (STK 1) NIL))))
02700			((AND (SPWD DEMOD) (CH /[) (<CLAUSES>) (CH /,) (<NUMBER>) (CH /]))
02800			 (CONS (QUOTE DEMOD) (CONS (STK 3) (CONS (STK 1) NIL))))
02900			((AND (SPWD DEFMODEL) (CH /[) (SPWD ID) (CH /])) (CONS (QUOTE DEFMODEL) (QUOTE ID)))
03000			((AND (CH /@) (<LISPR>)) (STK 0))
03100			((AND (<TERM0>) (<OPR>) (<TERM>)) (CONS (STK 1) (CONS (STK 2) (CONS (STK 0) NIL))))
03200			(*NIL*)))))) 
03300	EXPR)
03400	
03500	(DEFPROP <PREDLST1> 
03600	 (LAMBDA NIL (NLRR (QUOTE PREDLST1) (FUNCTION (LAMBDA NIL (COND ((AND (<PREDLST>)) (STK 0)) (*NIL*)))))) 
03700	EXPR)
03800	
03900	(DEFPROP <PREDLST> 
04000	 (LAMBDA NIL
04100	  (NLRR (QUOTE PREDLST)
04200		(FUNCTION
04300		 (LAMBDA NIL
04400		  (COND ((AND (<ID>) (CH /,) (<PREDLST>)) (CONS (STK 2) (STK 0)))
04500			((AND (<ID>)) (STK 0))
04600			((AND) NIL)
04700			(*NIL*)))))) 
04800	EXPR)
04900	
05000	(DEFPROP >PREDIC< 
05100	 (LAMBDA(%N)
05200	  (OUTRUL %N
05300		  (FUNCTION
05400		   (LAMBDA NIL
05500		    (COND ((EQ (QUOTE ANCESTRY) (STK1)) (QUOTE ANCESTRY))
05600			  ((EQ (QUOTE NONE) (STK1)) (QUOTE NONE))
05700			  ((EQ (QUOTE VINE) (STK1)) (QUOTE VINE))
05800			  ((EQ (QUOTE UNIT) (STK1)) (QUOTE UNIT))
05900			  ((EQ (QUOTE ALLPOS) (STK1)) (QUOTE P1))
06000			  ((EQ (QUOTE ALLNEG) (STK1)) (QUOTE P2))
06100			  ((AND (MATCH (QUOTE (SUPPORT . *))) (>C< 0))
06200			   (LIST (QUOTE SUPPORT) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06300			  ((AND (MATCH (QUOTE (GREATERP (DEPTH (CDR C)) *))) (>NUMBER< 0))
06400			   (LIST (QUOTE DEPTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06500			  ((AND (MATCH (QUOTE (GREATERP (LENGTH (CDR C)) *))) (>NUMBER< 0))
06600			   (LIST (QUOTE LENGTH) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
06700			  ((AND (MATCH (QUOTE (MODEL * *))) (>PREDLST< 1) (>PREDLST1< 0))
06800			   (LIST (QUOTE MODEL) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH ;)) (STK0) (QUOTE (:CH /]))))
06900			  ((AND (MATCH (QUOTE (EQUALITY * *))) (>OP< 1) (>NUMBER< 0))
07000			   (LIST (QUOTE EQUALITY) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
07100			  ((AND (MATCH (QUOTE (DEMOD * *))) (>CLAUSES< 1) (>NUMBER< 0))
07200			   (LIST (QUOTE DEMOD) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /,)) (STK0) (QUOTE (:CH /]))))
07300			  ((AND (MATCH (QUOTE (DEFMODEL . ID))))
07400			   (LIST (QUOTE DEFMODEL) (QUOTE (:CH /[)) (QUOTE ID) (QUOTE (:CH /]))))
07600			  ((AND (MATCH (QUOTE (* * *))) (>OPR< 2) (>TERM0< 1) (>TERM< 0))
07700			   (LIST (STK1) (STK2) (STK0)))
07750	((>LISPR< 1)(LIST(QUOTE(:CH /@))(STK1)))))))) 
07800	EXPR)
07900	
08000	(DEFPROP >PREDLST1< 
08100	 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>PREDLST< 1) (STK1))))))) 
08200	EXPR)
08300	
08400	(DEFPROP >PREDLST< 
08500	 (LAMBDA(%N)
08600	  (OUTRUL %N
08700		  (FUNCTION
08800		   (LAMBDA NIL
08900		    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
09000			  ((AND (MATCH (QUOTE (* . *))) (>ID< 1) (>PREDLST< 0)) (LIST (STK1) (QUOTE (:CH /,)) (STK0)))
09100			  ((>ID< 1) (STK1))))))) 
09200	EXPR)